Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Applications/DropBin 1.5/DropBin.p

Text File | 1997-05-20 | 4.7 KB | 196 lines | [TEXT/CWIE]

{******************************************************************************
//
//  DropBin v1.5
//
//  This program encodes a binhex file.  Either drop a file on this application,
//  or open a file from within this app, and it will binhex the file.
//
//  This program started as a port of a C program by Matthew Mora called AutoBin.
//  The CalcCRC stuff was replaced with a new routine created from scratch (using
//  the write-up on Binhex 4.0 that Peter N Lewis released).  Some other stuff was
//  also added to improve the user interface (better event handling, progress bar, etc.).
//
//
//  Programmed by Bill Catambay, 5/20/97.  E-mail at [e-mail]
//
******************************************************************************}
{!$pragma noreturn on}
{$NR+}

Program DropBin;

Uses
    Toolbox, DropBinUtils, DropBinAE, BinProgress;

Procedure InitGlobals;

Var
    aLong:    longint;

    begin
    gDone := false;
    gBackground := false;
    gState := false;
    gProcessing := false;
    gOApped := false;
    gHasAppleEvents    := Gestalt(gestaltAppleEventsAttr,aLong) = noErr;
    dbWindow := NIL;
    gRefNum := 0;
    gFilename := '';
    gOutputName := '';
    gStatType := kShowRemaining;
    end;

Procedure SetUpMenus;

    begin
    gAppleMenu := GetMenu ( kAppleNum );
    AppendResMenu(gAppleMenu, 'DRVR' );
    InsertMenu(gAppleMenu, 0 );
    gFileMenu := GetMenu(kFileNum);
    InsertMenu(gFileMenu, 0);
    DrawMenuBar;
    end;

Procedure StartEncode;

Var
    stdReply:        StandardFileReply;

    begin
    StandardGetFile(NIL, -1, NIL, stdReply);
    if stdReply.sfGood then
        SendODOCToSelf(stdReply.sfFile);
    end;

Procedure DoMenu(retVal: longint);

Var
    menuID, itemID:    integer;
    itemStr:        Str255;

    begin
    menuID := HiWord(retVal);
    itemID := LoWord(retVal);
    case menuID of
        kAppleNum:    if itemID = 1 then
                        Alert(128, NIL)
                    else
                        begin
                        GetMenuItemText(GetMenuHandle(kAppleNum), itemID, itemStr);
                        OpenDeskAcc(itemStr);
                        end;
        kFileNum:    if itemID = 1 then
                        begin
                        HiliteControl(encodeButton, 1);
                        Wait(5);
                        HiliteControl(encodeButton, 0);
                        StartEncode;
                        end
                    else
                        begin
                        HiliteControl(quitButton, 1);
                        SendQuitToSelf;    { send self a 'quit' event }
                        end;
        otherwise    ;
        end; { of CASE }
    HiliteMenu(0);        { turn it off! }
    end;

Procedure DoMouseDown(curEvent: EventRecord);

Var
    whichWindow:    WindowPtr;
    whichPart:        integer;
    control:         ControlRef;

    begin
    whichPart := FindWindow(curEvent.where, whichWindow);
    case whichPart of
        inMenuBar:        DoMenu(MenuSelect(curEvent.where));
        inContent:        if whichWindow = dbWindow then
                            begin
                            SetPort(dbWindow);
                            GlobalToLocal(curEvent.where);
                            if FindControl(curEvent.where, dbWindow, control) > 0 then
                                if TrackControl(control, curEvent.where, nil) > 0 then
                                    begin
                                    if control = quitButton then
                                        SendQuitToSelf;
                                    if control = encodeButton then
                                        StartEncode;
                                    end;
                            end;
        inSysWindow:    SystemClick(curEvent, whichWindow);
        inDrag:            DragWindow(whichWindow, curEvent.where, qd.screenBits.bounds);
        otherwise    ;
        end; { of CASE }
    end;

Procedure DoKeyDown(curEvent: EventRecord);

Var
    keyCode:    integer;

    begin
    keyCode := BAnd(curEvent.message, charCodeMask);
    if (keyCode = kReturnKey) or (keyCode = kEnterKey) then
        begin
        HiliteControl(encodeButton, 1);
        Wait(5);
        HiliteControl(encodeButton, 0);
        StartEncode;
        end
    else if BAnd(curEvent.modifiers,cmdKey) <> 0 then
        DoMenu(MenuKey(chr(keyCode)));
    end;

begin
InitToolbox;
InitGlobals;
if not gHasAppleEvents then
    ErrorAlert(kErrStringID, kCantRunErr, 0)
else
    begin
    InitAEVTStuff;
    SetUpMenus;
    while not gDone do
        begin
        gWasEvent := WaitNextEvent(everyEvent, gEvent, 60, NIL);
        if gWasEvent then
            case gEvent.what of
                kHighLevelEvent:    DoHighLevelEvent(gEvent);
                osEvt:                if BAnd(brotl(gEvent.message,8),$FF) = suspendResumeMessage then
                                        begin
                                        gBackground := BAnd(gEvent.message,resumeFlag) = 0;
                                        if gBackground then
                                            begin
                                            HiliteControl(encodeButton, 255);
                                            HiliteControl(quitButton, 255);
                                            MakeDefaultButton(encodeButton);
                                            end
                                        else
                                            begin
                                            HiliteControl(encodeButton, 0);
                                            HiliteControl(quitButton, 0);
                                            MakeDefaultButton(encodeButton);
                                            end;
                                        InvalRect(WindowPtr(gEvent.message)^.portRect);
                                        end;
                updateEvt:            begin
                                    InvalRect(WindowPtr(gEvent.message)^.portRect);
                                    ResetWindow(WindowPtr(gEvent.message));
                                    end;
                mouseDown:            DoMouseDown(gEvent);
                keyDown,
                autoKey:            DoKeyDown(gEvent);
                otherwise            ;
                end; { of CASE }
        if gState then
            begin
            SetupProgress;
            gState := false;
            end;
        end;
    end;
end.